home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 07 - 1991 / 07.11 Nov 91 / Code OOP Sources / Shell Code Resource < prev   
Encoding:
Text File  |  1991-02-09  |  8.5 KB  |  253 lines  |  [TEXT/PJMM]
  1. { This Code Resource handles a CDEF that is stored as a driver resource }
  2. { Our driver resource will actually be type 'DRVR', ID = 500.  }
  3. { NOTE: The DATA resource also compiled with the driver resource must have its ID changed }
  4. { to -32 }
  5. unit CDEFCode;
  6.  
  7. interface
  8.  
  9.     function Main (VarCode: Integer; TheControl: ControlHandle; message: integer; Param: Longint): Longint;
  10.  
  11. implementation
  12.  
  13.     const
  14. { these are the byte offsets into the driver header for the jmp offset table }
  15.         drvrSelOpenOffset = 2;    { in hiword of LongArrHdl^^[2] }
  16.         drvrSelCloseOffset = 4;    { in hiword of LongArrHdl^^[4] }
  17.         drvrSelControlOffset = 3;    { in hiword of LongArrHdl^^[3] }
  18.  
  19.         drvrResType = 'DRVR';
  20.         drvrResID = 500;
  21.         dataInternalID = 0;    { your DATA resource must have a resource ID of -(dataInternalID + 1) * 32 }
  22.  
  23.     type
  24. { this array typecasts the driver to access its offset table.  }
  25. { Because Think Pascal has no word type, we can extra the low or high word of LongInts }
  26. { using the Loword and Hiword routines }
  27.         LongArr = array[0..10] of LongInt;
  28.         LongArrPtr = ^LongArr;
  29.         LongArrHdl = ^LongArrPtr;
  30.  
  31.     function CallDriver (devCtlEnt: DCtlPtr; paramBlock: ParmBlkPtr; theDriverOfs: Ptr): integer;
  32.     inline
  33.         $2F0A,            {    MOVEA.L    A2,-(A7)        ; preserve A2 in the function return }
  34.         $246F, $0004,    {    MOVEA.L    4(A7),A2        ; Routine to jump to }
  35.         $206F, $0008,    {    MOVEA.L    $8(A7), A0    ; parmBlkPtr must go in A0    }
  36.         $226F, $000C,    {    MOVEA.L    $C(A7), A1    ; dCtlPtr must go in A1 }
  37.         $4E92,            {    JSR        (A2)            ; call the driver - D0 will contain the result }
  38.         $245F,            {    MOVEA.L    (A7)+,A2        ; restore A2 before setting return value }
  39.         $DEFC, $000C,    {    ADDA.W    #$C, A7        ; restore the stack except for function return value }
  40.         $3E80;            {    MOVEA.L    D0, (A7)        ; return value on stack }
  41.  
  42. {---------------------------------------------------------------}
  43.  
  44.     function Main (VarCode: Integer; TheControl: ControlHandle; message: integer; Param: Longint): Longint;
  45.  
  46.         type
  47.         { CodeToDriver passes parameters from the code resource into driver }
  48.         { add or change any parameters that apply to your code resource }
  49.             CodeToDriver = record
  50.                     fMessage: integer;    { message }
  51.                     fVarCode: integer;    { VarCode }
  52.                     fControl: ControlHandle;    { theControl }
  53.                     fParam: LongInt;        { Param }
  54.                     fResult: LongInt;    { result to return to Control Manager }
  55.                 end;
  56.             CtoDPtr = ^CodeToDriver;
  57.             CtoDHdl = ^CtoDPtr;
  58.  
  59.         {******************************************}
  60.  
  61.         procedure InitRtn;
  62.             { 1. Allocate and initialize dCtlEntry and store it in theControl^^.contrlData }
  63.             { 2. Load the driver and store it in dCtlEntry.dCtlDriver }
  64.             { 2. Call the driver with the Open message }
  65.             var
  66.                 theDCEHdl: DCtlHandle;
  67.                 theDriver: Handle;
  68.                 theCtoDHdl: CtoDHdl;
  69.                 theOSErr: OSErr;
  70.                 dummyIOPB: ParamBlockRec;    { used as a dummy field }
  71.                 driverOfs: Ptr;
  72.                 name: Str255;
  73.         begin
  74.             { allocate the Driver Control Entry }
  75.             theDCEHdl := DCtlHandle(NewHandle(sizeof(DCtlEntry)));
  76.                             {** memory error handling here **}
  77.             MoveHHi(handle(theDCEHdl));
  78.             HLock(handle(theDCEHdl));
  79.  
  80.             { allocate CodeToDriver and set it up. }
  81.             { Fields fVarCode and fControl only need to be set once }
  82.             theCtoDHdl := CtoDHdl(NewHandle(sizeof(CodeToDriver)));
  83.                             {** memory error handling here **}
  84.             MoveHHi(handle(theCtoDHdl));
  85.             HLock(handle(theCtoDHdl));
  86.             with theCtoDHdl^^ do
  87.                 begin
  88.                     fMessage := initCntl;
  89.                     fVarCode := varCode;
  90.                     fControl := theControl;
  91.                     fParam := param;
  92.                 end;    { with theCtoDHdl^^ }
  93.  
  94.             { load the driver }
  95.             theDriver := GetResource(drvrResType, drvrResID);
  96.                             {** memory error handling here **}
  97.             MoveHHi(theDriver);
  98.             HLock(theDriver);
  99.             HNoPurge(theDriver);
  100.  
  101.             { fill in the Driver Control Entry and store it in the control }
  102.             with theDCEHdl^^ do
  103.                 begin
  104.                     dCtlDriver := Ptr(theDriver);
  105.                     dCtlFlags := $4400;    { allow Control }
  106.                     dCtlQHdr.qFlags := 0;    { not used }
  107.                     dCtlQHdr.qHead := nil;    { not used }
  108.                     dCtlQHdr.qTail := nil;    { not used }
  109.                     dCtlPosition := ord4(theCtoDHdl);    { passing parameter block }
  110.                     dCtlStorage := nil;    { for Think Pascal to set it up during Open }
  111.                     dCtlRefNum := dataInternalID;    { Think will calculate an ID of -32 for its DATA resource }
  112.                     dCtlCurTicks := 0;    { not used }
  113.                     dCtlWindow := nil;    { not used }
  114.                     dCtlDelay := 0;    { not used }
  115.                     dCtlEMask := 0;    { not used }
  116.                     dCtlMenu := 0;        { not used }
  117.                 end;    { with theDCEHdl^^ }
  118.             theControl^^.contrlData := handle(theDCEHdl);
  119.  
  120.         { now call the driver with the Open selector. dummyIOPB is a dummy field }
  121.         { theDCEHdl and theDriver are already locked }
  122.             driverOfs := Ptr(ord4(theDriver^) + hiword(LongArrHdl(theDriver)^^[drvrSelOpenOffset]));
  123.  
  124.         { Although we fill in some of dummyIOPB, the Think Pascal 2.0 }
  125.         { driver structure doesn't use it }
  126.             with dummyIOPB do
  127.                 begin
  128.                     qLink := nil;
  129.                     qType := Ord(ioQType);
  130.                     ioCmdAddr := driverOfs;
  131.                     ioTrap := 0;
  132.                     ioCompletion := nil;
  133.                     Name := '.Driver Name';
  134.                     ioNamePtr := @Name;
  135.                     ioRefNum := drvrResID + 1;    { driver refNum + 1 }
  136.                 end;    { with dummyIOPB }
  137.             theOSErr := CallDriver(theDCEHdl^, @dummyIOPB, driverOfs);
  138.                             {** error handling here **}
  139.         end;    { InitRtn }
  140.  
  141.         {******************************************}
  142.  
  143.         procedure DisposeRtn;
  144.             { 1. Call the Driver with the close message }
  145.             {    so it can unload its storage and segments }
  146.             { 2. Dispose our own storage }
  147.             var
  148.                 theDCEHdl: DCtlHandle;
  149.                 theDriver: Handle;
  150.                 theCtoDHdl: CtoDHdl;
  151.                 theOSErr: OSErr;
  152.                 dummyIOPB: ParamBlockRec;    { used as a dummy field }
  153.                 driverOfs: Ptr;
  154.  
  155.         begin
  156.             theDCEHdl := DCtlHandle(theControl^^.contrlData);
  157.             theDriver := handle(theDCEHdl^^.dCtlDriver);
  158.             LoadResource(theDriver);    { in case it was purged after another code resource using it was disposed }
  159.             HNoPurge(theDriver);
  160.             HLock(theDriver);    { in case it was unlocked by Think }
  161.             theCtoDHdl := CtoDHdl(theDCEHdl^^.dCtlPosition);
  162.  
  163.         { Call the driver with the Close selector. dummyIOPB is a dummy field }
  164.         { theDCEHdl and theDriver are already locked }
  165.             theCtoDHdl^^.fMessage := dispCntl;    { not really used, but... }
  166.             driverOfs := Ptr(ord4(theDriver^) + hiword(LongArrHdl(theDriver)^^[drvrSelCloseOffset]));
  167.  
  168.         { Although we fill in some of dummyIOPB, the Think Pascal 2.0 }
  169.         { driver structure doesn't use it }
  170.             with dummyIOPB do
  171.                 begin
  172.                     qLink := nil;
  173.                     qType := Ord(ioQType);
  174.                     ioCmdAddr := driverOfs;
  175.                     ioTrap := 0;
  176.                     ioCompletion := nil;
  177.                     ioRefNum := drvrResID + 1;    { driver refNum + 1 }
  178.                 end;    { with dummyIOPB }
  179.             theOSErr := CallDriver(theDCEHdl^, @dummyIOPB, driverOfs);
  180.  
  181.             { now dispose structures }
  182.             DisposHandle(handle(theCtoDhdl));
  183.             DisposHandle(handle(theDCEHdl));
  184.             { don't dispose the driver since we may be sharing it with many instances of this CDEF }
  185.             { instead, mark it to be purged and always call LoadResource before using it elsewhere }
  186.             HPurge(theDriver);
  187.         end;    { DisposeRtn }
  188.  
  189.         {******************************************}
  190.  
  191.         function OtherRtns: LongInt;
  192.             { 1. setup message }
  193.             { 2. call driver with Control command }
  194.             { 3. return function value }
  195.             var
  196.                 theDCEHdl: DCtlHandle;
  197.                 theDriver: Handle;
  198.                 theCtoDHdl: CtoDHdl;
  199.                 theOSErr: OSErr;
  200.                 dummyIOPB: ParamBlockRec;    { used as a dummy field }
  201.                 driverOfs: Ptr;
  202.  
  203.         begin
  204.             theDCEHdl := DCtlHandle(theControl^^.contrlData);
  205.             theDriver := handle(theDCEHdl^^.dCtlDriver);
  206.             LoadResource(theDriver);    { in case it was purged after another code resource using it was disposed }
  207.             HNoPurge(theDriver);
  208.             HLock(theDriver);    { in case it was unlocked by Think }
  209.             theCtoDHdl := CtoDHdl(theDCEHdl^^.dCtlPosition);
  210.  
  211.             with theCtoDHdl^^ do
  212.                 begin
  213.                     fMessage := message;
  214.                     fParam := param;
  215.                     fResult := 0;    { init }
  216.                 end;    { with }
  217.  
  218.         { Call the driver with the Control selector. dummyIOPB is a dummy field }
  219.         { theDCEHdl and theDriver are already locked }
  220.             driverOfs := Ptr(ord4(theDriver^) + hiword(LongArrHdl(theDriver)^^[drvrSelControlOffset]));
  221.  
  222.         { Although we fill in some of dummyIOPB, the Think Pascal 2.0 }
  223.         { driver structure doesn't use it }
  224.             with dummyIOPB do
  225.                 begin
  226.                     qLink := nil;
  227.                     qType := Ord(ioQType);
  228.                     ioCmdAddr := driverOfs;
  229.                     ioTrap := 0;
  230.                     ioCompletion := nil;
  231.                     ioRefNum := drvrResID + 1;    { driver refNum + 1 }
  232.                 end;    { with dummyIOPB }
  233.             theOSErr := CallDriver(theDCEHdl^, @dummyIOPB, driverOfs);
  234.  
  235.             OtherRtns := theCtoDHdl^^.fResult;
  236.         end;    { OtherRtns }
  237.  
  238.         {******************************************}
  239.  
  240.     begin
  241.         Main := 0;    { initialize function result }
  242.         case Message of
  243.             InitCntl: 
  244.                 InitRtn;
  245.             DispCntl: 
  246.                 DisposeRtn;
  247.             otherwise
  248.                 Main := OtherRtns;
  249.         end;    { CASE }
  250.     end;    { Main }
  251.  
  252.  
  253. end.    { UNIT CDEFCode }